home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ELECTRIC / DSPICE0S.ZIP / jfet.c < prev    next >
C/C++ Source or Header  |  1992-11-22  |  29KB  |  853 lines
  1. /* jfet.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  33.         sfactr;
  34.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  35.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  36. } status_;
  37.  
  38. #define status_1 status_
  39.  
  40. struct {
  41.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  42.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  43.          pivrel;
  44. } knstnt_;
  45.  
  46. #define knstnt_1 knstnt_
  47.  
  48. struct {
  49.     doublereal value[200000];
  50. } blank_;
  51.  
  52. #define blank_1 blank_
  53.  
  54. /*<       subroutine jfet >*/
  55. /* Subroutine */ int jfet_()
  56. {
  57.     /* System generated locals */
  58.     integer i_1;
  59.     doublereal d_1, d_2, d_3;
  60.  
  61.     /* Builtin functions */
  62.     double exp(), sqrt();
  63.  
  64.     /* Local variables */
  65.     static doublereal area, fcpb, beta;
  66. #define cgdo ((doublereal *)&blank_1 + 4)
  67. #define cqgd ((doublereal *)&blank_1 + 12)
  68. #define ggdo ((doublereal *)&blank_1 + 8)
  69.     static doublereal phib;
  70.     static integer ioff;
  71.     static doublereal evgd, czgd;
  72.     static integer locm;
  73. #define gdso ((doublereal *)&blank_1 + 6)
  74. #define vgdo ((doublereal *)&blank_1 + 1)
  75. #define ggso ((doublereal *)&blank_1 + 7)
  76. #define cqgs ((doublereal *)&blank_1 + 10)
  77.     static integer locv, loct;
  78.     static doublereal gdpr;
  79. #define vgso ((doublereal *)&blank_1)
  80.     static doublereal type, gspr, csat, evgs, vgst, twob, vgdt, czgs, twop, 
  81.         sarg, fcpb2;
  82.     static integer locy, ichk1, node1, node2, node3, node4, node5;
  83.     static doublereal capgd, cdhat, cghat, ceqgd, betap, capgs, cdreq, ceqgs, 
  84.         xlamb, xfact, vcrit, f1, f2, f3, czgdf2, czgsf2, cd, cg;
  85.     extern /* Subroutine */ int intgr8_();
  86.     static doublereal gm;
  87.     static integer icheck;
  88.     static doublereal cdrain, delvgd;
  89. #define nodplc ((integer *)&blank_1)
  90. #define cvalue ((complex *)&blank_1)
  91.     static doublereal delvgs, delvds;
  92.     extern /* Subroutine */ int pnjlim_(), fetlim_();
  93.     static doublereal cgd, ggd;
  94. #define cdo ((doublereal *)&blank_1 + 3)
  95. #define cgo ((doublereal *)&blank_1 + 2)
  96.     static doublereal ceq;
  97. #define qgd ((doublereal *)&blank_1 + 11)
  98.     static integer loc;
  99.     static doublereal gds, geq, vgd;
  100. #define gmo ((doublereal *)&blank_1 + 5)
  101.     static doublereal ggs;
  102. #define qgs ((doublereal *)&blank_1 + 9)
  103.     static doublereal vds, vgs, tol, vto;
  104.  
  105. /*<       implicit double precision (a-h,o-z) >*/
  106.  
  107. /*     this routine processes jfets for dc and transient analyses. */
  108.  
  109. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  110. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  111. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  112. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  113. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  114. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  115. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  116. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  117. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  118. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  119. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  120. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  121. /* spice version 2g.6  sccsid=status 3/15/83 */
  122. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  123. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  124. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  125. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  126. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  127. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  128. /*<      2   pivtol,pivrel >*/
  129. /* spice version 2g.6  sccsid=blank 3/15/83 */
  130. /*<       common /blank/ value(200000) >*/
  131. /*<       integer nodplc(64) >*/
  132. /*<       complex cvalue(32) >*/
  133. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  134.  
  135.  
  136. /*<       dimension vgso(1),vgdo(1),cgo(1),cdo(1),cgdo(1),gmo(1),gdso(1), >*/
  137. /*<      1   ggso(1),ggdo(1),qgs(1),cqgs(1),qgd(1),cqgd(1) >*/
  138. /*<       equivalence (vgso(1),value( 1)),(vgdo(1),value( 2)), >*/
  139. /*<      1            (cgo (1),value( 3)),(cdo (1),value( 4)), >*/
  140. /*<      2            (cgdo(1),value( 5)),(gmo (1),value( 6)), >*/
  141. /*<      3            (gdso(1),value( 7)),(ggso(1),value( 8)), >*/
  142. /*<      4            (ggdo(1),value( 9)),(qgs (1),value(10)), >*/
  143. /*<      5            (cqgs(1),value(11)),(qgd (1),value(12)), >*/
  144. /*<      6            (cqgd(1),value(13)) >*/
  145.  
  146.  
  147. /*<       loc=locate(13) >*/
  148.     loc = cirdat_1.locate[12];
  149. /*<    10 if ((loc.eq.0).or.(nodplc(loc+25).ne.0)) return >*/
  150. L10:
  151.     if (loc == 0 || nodplc[loc + 24] != 0) {
  152.     return 0;
  153.     }
  154. /*<       locv=nodplc(loc+1) >*/
  155.     locv = nodplc[loc];
  156. /*<       node1=nodplc(loc+2) >*/
  157.     node1 = nodplc[loc + 1];
  158. /*<       node2=nodplc(loc+3) >*/
  159.     node2 = nodplc[loc + 2];
  160. /*<       node3=nodplc(loc+4) >*/
  161.     node3 = nodplc[loc + 3];
  162. /*<       node4=nodplc(loc+5) >*/
  163.     node4 = nodplc[loc + 4];
  164. /*<       node5=nodplc(loc+6) >*/
  165.     node5 = nodplc[loc + 5];
  166. /*<       locm=nodplc(loc+7) >*/
  167.     locm = nodplc[loc + 6];
  168. /*<       ioff=nodplc(loc+8) >*/
  169.     ioff = nodplc[loc + 7];
  170. /*<       type=nodplc(locm+2) >*/
  171.     type = (doublereal) nodplc[locm + 1];
  172. /*<       locm=nodplc(locm+1) >*/
  173.     locm = nodplc[locm];
  174. /*<       loct=nodplc(loc+19) >*/
  175.     loct = nodplc[loc + 18];
  176.  
  177. /*  dc model parameters */
  178.  
  179. /*<       area=value(locv+1) >*/
  180.     area = blank_1.value[locv];
  181. /*<       vto=value(locm+1) >*/
  182.     vto = blank_1.value[locm];
  183. /*<       beta=value(locm+2)*area >*/
  184.     beta = blank_1.value[locm + 1] * area;
  185. /*<       xlamb=value(locm+3) >*/
  186.     xlamb = blank_1.value[locm + 2];
  187. /*<       gdpr=value(locm+4)*area >*/
  188.     gdpr = blank_1.value[locm + 3] * area;
  189. /*<       gspr=value(locm+5)*area >*/
  190.     gspr = blank_1.value[locm + 4] * area;
  191. /*<       csat=value(locm+9)*area >*/
  192.     csat = blank_1.value[locm + 8] * area;
  193. /*<       vcrit=value(locm+16) >*/
  194.     vcrit = blank_1.value[locm + 15];
  195.  
  196. /*  initialization */
  197.  
  198. /*<       icheck=1 >*/
  199.     icheck = 1;
  200. /*<       go to (100,20,30,50,60,70), initf >*/
  201.     switch (status_1.initf) {
  202.     case 1:  goto L100;
  203.     case 2:  goto L20;
  204.     case 3:  goto L30;
  205.     case 4:  goto L50;
  206.     case 5:  goto L60;
  207.     case 6:  goto L70;
  208.     }
  209. /*<    20 if(mode.ne.1.or.modedc.ne.2.or.nosolv.eq.0) go to 25 >*/
  210. L20:
  211.     if (status_1.mode != 1 || status_1.modedc != 2 || status_1.nosolv == 0) {
  212.     goto L25;
  213.     }
  214. /*<       vds=type*value(locv+2) >*/
  215.     vds = type * blank_1.value[locv + 1];
  216. /*<       vgs=type*value(locv+3) >*/
  217.     vgs = type * blank_1.value[locv + 2];
  218. /*<       vgd=vgs-vds >*/
  219.     vgd = vgs - vds;
  220. /*<       go to 300 >*/
  221.     goto L300;
  222. /*<    25 if(ioff.ne.0) go to 40 >*/
  223. L25:
  224.     if (ioff != 0) {
  225.     goto L40;
  226.     }
  227. /*<       vgs=-1.0d0 >*/
  228.     vgs = -1.;
  229. /*<       vgd=-1.0d0 >*/
  230.     vgd = -1.;
  231. /*<       go to 300 >*/
  232.     goto L300;
  233. /*<    30 if (ioff.eq.0) go to 100 >*/
  234. L30:
  235.     if (ioff == 0) {
  236.     goto L100;
  237.     }
  238. /*<    40 vgs=0.0d0 >*/
  239. L40:
  240.     vgs = 0.;
  241. /*<       vgd=0.0d0 >*/
  242.     vgd = 0.;
  243. /*<       go to 300 >*/
  244.     goto L300;
  245. /*<    50 vgs=vgso(lx0+loct) >*/
  246. L50:
  247.     vgs = vgso[tabinf_1.lx0 + loct - 1];
  248. /*<       vgd=vgdo(lx0+loct) >*/
  249.     vgd = vgdo[tabinf_1.lx0 + loct - 1];
  250. /*<       go to 300 >*/
  251.     goto L300;
  252. /*<    60 vgs=vgso(lx1+loct) >*/
  253. L60:
  254.     vgs = vgso[tabinf_1.lx1 + loct - 1];
  255. /*<       vgd=vgdo(lx1+loct) >*/
  256.     vgd = vgdo[tabinf_1.lx1 + loct - 1];
  257. /*<       go to 300 >*/
  258.     goto L300;
  259. /*<    70 xfact=delta/delold(2) >*/
  260. L70:
  261.     xfact = status_1.delta / status_1.delold[1];
  262. /*<       vgso(lx0+loct)=vgso(lx1+loct) >*/
  263.     vgso[tabinf_1.lx0 + loct - 1] = vgso[tabinf_1.lx1 + loct - 1];
  264. /*<       vgs=(1.0d0+xfact)*vgso(lx1+loct)-xfact*vgso(lx2+loct) >*/
  265.     vgs = (xfact + 1.) * vgso[tabinf_1.lx1 + loct - 1] - xfact * vgso[
  266.         tabinf_1.lx2 + loct - 1];
  267. /*<       vgdo(lx0+loct)=vgdo(lx1+loct) >*/
  268.     vgdo[tabinf_1.lx0 + loct - 1] = vgdo[tabinf_1.lx1 + loct - 1];
  269. /*<       vgd=(1.0d0+xfact)*vgdo(lx1+loct)-xfact*vgdo(lx2+loct) >*/
  270.     vgd = (xfact + 1.) * vgdo[tabinf_1.lx1 + loct - 1] - xfact * vgdo[
  271.         tabinf_1.lx2 + loct - 1];
  272. /*<       cgo(lx0+loct)=cgo(lx1+loct) >*/
  273.     cgo[tabinf_1.lx0 + loct - 1] = cgo[tabinf_1.lx1 + loct - 1];
  274. /*<       cdo(lx0+loct)=cdo(lx1+loct) >*/
  275.     cdo[tabinf_1.lx0 + loct - 1] = cdo[tabinf_1.lx1 + loct - 1];
  276. /*<       cgdo(lx0+loct)=cgdo(lx1+loct) >*/
  277.     cgdo[tabinf_1.lx0 + loct - 1] = cgdo[tabinf_1.lx1 + loct - 1];
  278. /*<       gmo(lx0+loct)=gmo(lx1+loct) >*/
  279.     gmo[tabinf_1.lx0 + loct - 1] = gmo[tabinf_1.lx1 + loct - 1];
  280. /*<       gdso(lx0+loct)=gdso(lx1+loct) >*/
  281.     gdso[tabinf_1.lx0 + loct - 1] = gdso[tabinf_1.lx1 + loct - 1];
  282. /*<       ggso(lx0+loct)=ggso(lx1+loct) >*/
  283.     ggso[tabinf_1.lx0 + loct - 1] = ggso[tabinf_1.lx1 + loct - 1];
  284. /*<       ggdo(lx0+loct)=ggdo(lx1+loct) >*/
  285.     ggdo[tabinf_1.lx0 + loct - 1] = ggdo[tabinf_1.lx1 + loct - 1];
  286. /*<       go to 110 >*/
  287.     goto L110;
  288.  
  289. /*  compute new nonlinear branch voltages */
  290.  
  291. /*<   100 vgs=type*(value(lvnim1+node2)-value(lvnim1+node5)) >*/
  292. L100:
  293.     vgs = type * (blank_1.value[tabinf_1.lvnim1 + node2 - 1] - blank_1.value[
  294.         tabinf_1.lvnim1 + node5 - 1]);
  295. /*<       vgd=type*(value(lvnim1+node2)-value(lvnim1+node4)) >*/
  296.     vgd = type * (blank_1.value[tabinf_1.lvnim1 + node2 - 1] - blank_1.value[
  297.         tabinf_1.lvnim1 + node4 - 1]);
  298. /*<   110 delvgs=vgs-vgso(lx0+loct) >*/
  299. L110:
  300.     delvgs = vgs - vgso[tabinf_1.lx0 + loct - 1];
  301. /*<       delvgd=vgd-vgdo(lx0+loct) >*/
  302.     delvgd = vgd - vgdo[tabinf_1.lx0 + loct - 1];
  303. /*<       delvds=delvgs-delvgd >*/
  304.     delvds = delvgs - delvgd;
  305. /*<       cghat=cgo(lx0+loct)+ggdo(lx0+loct)*delvgd+ggso(lx0+loct)*delvgs >*/
  306.     cghat = cgo[tabinf_1.lx0 + loct - 1] + ggdo[tabinf_1.lx0 + loct - 1] * 
  307.         delvgd + ggso[tabinf_1.lx0 + loct - 1] * delvgs;
  308. /*<       cdhat=cdo(lx0+loct)+gmo(lx0+loct)*delvgs+gdso(lx0+loct)*delvds >*/
  309. /*<      1   -ggdo(lx0+loct)*delvgd >*/
  310.     cdhat = cdo[tabinf_1.lx0 + loct - 1] + gmo[tabinf_1.lx0 + loct - 1] * 
  311.         delvgs + gdso[tabinf_1.lx0 + loct - 1] * delvds - ggdo[
  312.         tabinf_1.lx0 + loct - 1] * delvgd;
  313.  
  314. /*  bypass if solution has not changed */
  315.  
  316. /*<       if (initf.eq.6) go to 200 >*/
  317.     if (status_1.initf == 6) {
  318.     goto L200;
  319.     }
  320. /*<       tol=reltol*dmax1(dabs(vgs),dabs(vgso(lx0+loct)))+vntol >*/
  321. /* Computing MAX */
  322.     d_2 = abs(vgs), d_3 = (d_1 = vgso[tabinf_1.lx0 + loct - 1], abs(d_1));
  323.     tol = knstnt_1.reltol * max(d_3,d_2) + knstnt_1.vntol;
  324. /*<       if (dabs(delvgs).ge.tol) go to 200 >*/
  325.     if (abs(delvgs) >= tol) {
  326.     goto L200;
  327.     }
  328. /*<       tol=reltol*dmax1(dabs(vgd),dabs(vgdo(lx0+loct)))+vntol >*/
  329. /* Computing MAX */
  330.     d_2 = abs(vgd), d_3 = (d_1 = vgdo[tabinf_1.lx0 + loct - 1], abs(d_1));
  331.     tol = knstnt_1.reltol * max(d_3,d_2) + knstnt_1.vntol;
  332. /*<       if (dabs(delvgd).ge.tol) go to 200 >*/
  333.     if (abs(delvgd) >= tol) {
  334.     goto L200;
  335.     }
  336. /*<       tol=reltol*dmax1(dabs(cghat),dabs(cgo(lx0+loct)))+abstol >*/
  337. /* Computing MAX */
  338.     d_2 = abs(cghat), d_3 = (d_1 = cgo[tabinf_1.lx0 + loct - 1], abs(d_1));
  339.     tol = knstnt_1.reltol * max(d_3,d_2) + knstnt_1.abstol;
  340. /*<       if (dabs(cghat-cgo(lx0+loct)).ge.tol) go to 200 >*/
  341.     if ((d_1 = cghat - cgo[tabinf_1.lx0 + loct - 1], abs(d_1)) >= tol) {
  342.     goto L200;
  343.     }
  344. /*<       tol=reltol*dmax1(dabs(cdhat),dabs(cdo(lx0+loct)))+abstol >*/
  345. /* Computing MAX */
  346.     d_2 = abs(cdhat), d_3 = (d_1 = cdo[tabinf_1.lx0 + loct - 1], abs(d_1));
  347.     tol = knstnt_1.reltol * max(d_3,d_2) + knstnt_1.abstol;
  348. /*<       if (dabs(cdhat-cdo(lx0+loct)).ge.tol) go to 200 >*/
  349.     if ((d_1 = cdhat - cdo[tabinf_1.lx0 + loct - 1], abs(d_1)) >= tol) {
  350.     goto L200;
  351.     }
  352. /*<       vgs=vgso(lx0+loct) >*/
  353.     vgs = vgso[tabinf_1.lx0 + loct - 1];
  354. /*<       vgd=vgdo(lx0+loct) >*/
  355.     vgd = vgdo[tabinf_1.lx0 + loct - 1];
  356. /*<       vds=vgs-vgd >*/
  357.     vds = vgs - vgd;
  358. /*<       cg=cgo(lx0+loct) >*/
  359.     cg = cgo[tabinf_1.lx0 + loct - 1];
  360. /*<       cd=cdo(lx0+loct) >*/
  361.     cd = cdo[tabinf_1.lx0 + loct - 1];
  362. /*<       cgd=cgdo(lx0+loct) >*/
  363.     cgd = cgdo[tabinf_1.lx0 + loct - 1];
  364. /*<       gm=gmo(lx0+loct) >*/
  365.     gm = gmo[tabinf_1.lx0 + loct - 1];
  366. /*<       gds=gdso(lx0+loct) >*/
  367.     gds = gdso[tabinf_1.lx0 + loct - 1];
  368. /*<       ggs=ggso(lx0+loct) >*/
  369.     ggs = ggso[tabinf_1.lx0 + loct - 1];
  370. /*<       ggd=ggdo(lx0+loct) >*/
  371.     ggd = ggdo[tabinf_1.lx0 + loct - 1];
  372. /*<       go to 900 >*/
  373.     goto L900;
  374.  
  375. /*  limit nonlinear branch voltages */
  376.  
  377. /*<   200 ichk1=1 >*/
  378. L200:
  379.     ichk1 = 1;
  380. /*<       call pnjlim(vgs,vgso(lx0+loct),vt,vcrit,icheck) >*/
  381.     pnjlim_(&vgs, &vgso[tabinf_1.lx0 + loct - 1], &status_1.vt, &vcrit, &
  382.         icheck);
  383. /*<       call pnjlim(vgd,vgdo(lx0+loct),vt,vcrit,ichk1) >*/
  384.     pnjlim_(&vgd, &vgdo[tabinf_1.lx0 + loct - 1], &status_1.vt, &vcrit, &
  385.         ichk1);
  386. /*<       if (ichk1.eq.1) icheck=1 >*/
  387.     if (ichk1 == 1) {
  388.     icheck = 1;
  389.     }
  390. /*<       call fetlim(vgs,vgso(lx0+loct),vto) >*/
  391.     fetlim_(&vgs, &vgso[tabinf_1.lx0 + loct - 1], &vto);
  392. /*<       call fetlim(vgd,vgdo(lx0+loct),vto) >*/
  393.     fetlim_(&vgd, &vgdo[tabinf_1.lx0 + loct - 1], &vto);
  394.  
  395. /*  determine dc current and derivatives */
  396.  
  397. /*<   300 vds=vgs-vgd >*/
  398. L300:
  399.     vds = vgs - vgd;
  400. /*<       if (vgs.gt.-5.0d0*vt) go to 310 >*/
  401.     if (vgs > status_1.vt * -5.) {
  402.     goto L310;
  403.     }
  404. /*<       ggs=-csat/vgs+gmin >*/
  405.     ggs = -csat / vgs + knstnt_1.gmin;
  406. /*<       cg=ggs*vgs >*/
  407.     cg = ggs * vgs;
  408. /*<       go to 320 >*/
  409.     goto L320;
  410. /*<   310 evgs=dexp(vgs/vt) >*/
  411. L310:
  412.     evgs = exp(vgs / status_1.vt);
  413. /*<       ggs=csat*evgs/vt+gmin >*/
  414.     ggs = csat * evgs / status_1.vt + knstnt_1.gmin;
  415. /*<       cg=csat*(evgs-1.0d0)+gmin*vgs >*/
  416.     cg = csat * (evgs - 1.) + knstnt_1.gmin * vgs;
  417. /*<   320 if (vgd.gt.-5.0d0*vt) go to 330 >*/
  418. L320:
  419.     if (vgd > status_1.vt * -5.) {
  420.     goto L330;
  421.     }
  422. /*<       ggd=-csat/vgd+gmin >*/
  423.     ggd = -csat / vgd + knstnt_1.gmin;
  424. /*<       cgd=ggd*vgd >*/
  425.     cgd = ggd * vgd;
  426. /*<       go to 340 >*/
  427.     goto L340;
  428. /*<   330 evgd=dexp(vgd/vt) >*/
  429. L330:
  430.     evgd = exp(vgd / status_1.vt);
  431. /*<       ggd=csat*evgd/vt+gmin >*/
  432.     ggd = csat * evgd / status_1.vt + knstnt_1.gmin;
  433. /*<       cgd=csat*(evgd-1.0d0)+gmin*vgd >*/
  434.     cgd = csat * (evgd - 1.) + knstnt_1.gmin * vgd;
  435. /*<   340 cg=cg+cgd >*/
  436. L340:
  437.     cg += cgd;
  438.  
  439. /*  compute drain current and derivitives for normal mode */
  440.  
  441. /*<   400 if (vds.lt.0.0d0) go to 450 >*/
  442. /* L400: */
  443.     if (vds < 0.) {
  444.     goto L450;
  445.     }
  446. /*<       vgst=vgs-vto >*/
  447.     vgst = vgs - vto;
  448.  
  449. /*  normal mode, cutoff region */
  450.  
  451. /*<       if (vgst.gt.0.0d0) go to 410 >*/
  452.     if (vgst > 0.) {
  453.     goto L410;
  454.     }
  455. /*<       cdrain=0.0d0 >*/
  456.     cdrain = 0.;
  457. /*<       gm=0.0d0 >*/
  458.     gm = 0.;
  459. /*<       gds=0.0d0 >*/
  460.     gds = 0.;
  461. /*<       go to 490 >*/
  462.     goto L490;
  463.  
  464. /*  normal mode, saturation region */
  465.  
  466. /*<   410 betap=beta*(1.0d0+xlamb*vds) >*/
  467. L410:
  468.     betap = beta * (xlamb * vds + 1.);
  469. /*<       twob=betap+betap >*/
  470.     twob = betap + betap;
  471. /*<       if (vgst.gt.vds) go to 420 >*/
  472.     if (vgst > vds) {
  473.     goto L420;
  474.     }
  475. /*<       cdrain=betap*vgst*vgst >*/
  476.     cdrain = betap * vgst * vgst;
  477. /*<       gm=twob*vgst >*/
  478.     gm = twob * vgst;
  479. /*<       gds=xlamb*beta*vgst*vgst >*/
  480.     gds = xlamb * beta * vgst * vgst;
  481. /*<       go to 490 >*/
  482.     goto L490;
  483.  
  484. /*  normal mode, linear region */
  485.  
  486. /*<   420 cdrain=betap*vds*(vgst+vgst-vds) >*/
  487. L420:
  488.     cdrain = betap * vds * (vgst + vgst - vds);
  489. /*<       gm=twob*vds >*/
  490.     gm = twob * vds;
  491. /*<       gds=twob*(vgst-vds)+xlamb*beta*vds*(vgst+vgst-vds) >*/
  492.     gds = twob * (vgst - vds) + xlamb * beta * vds * (vgst + vgst - vds);
  493. /*<       go to 490 >*/
  494.     goto L490;
  495.  
  496. /*  compute drain current and derivitives for inverse mode */
  497.  
  498. /*<   450 vgdt=vgd-vto >*/
  499. L450:
  500.     vgdt = vgd - vto;
  501.  
  502. /*  inverse mode, cutoff region */
  503.  
  504. /*<       if (vgdt.gt.0.0d0) go to 460 >*/
  505.     if (vgdt > 0.) {
  506.     goto L460;
  507.     }
  508. /*<       cdrain=0.0d0 >*/
  509.     cdrain = 0.;
  510. /*<       gm=0.0d0 >*/
  511.     gm = 0.;
  512. /*<       gds=0.0d0 >*/
  513.     gds = 0.;
  514. /*<       go to 490 >*/
  515.     goto L490;
  516.  
  517. /*  inverse mode, saturation region */
  518.  
  519. /*<   460 betap=beta*(1.0d0-xlamb*vds) >*/
  520. L460:
  521.     betap = beta * (1. - xlamb * vds);
  522. /*<       twob=betap+betap >*/
  523.     twob = betap + betap;
  524. /*<       if (vgdt.gt.-vds) go to 470 >*/
  525.     if (vgdt > -vds) {
  526.     goto L470;
  527.     }
  528. /*<       cdrain=-betap*vgdt*vgdt >*/
  529.     cdrain = -betap * vgdt * vgdt;
  530. /*<       gm=-twob*vgdt >*/
  531.     gm = -twob * vgdt;
  532. /*<       gds=xlamb*beta*vgdt*vgdt-gm >*/
  533.     gds = xlamb * beta * vgdt * vgdt - gm;
  534. /*<       go to 490 >*/
  535.     goto L490;
  536.  
  537. /*  inverse mode, linear region */
  538.  
  539. /*<   470 cdrain=betap*vds*(vgdt+vgdt+vds) >*/
  540. L470:
  541.     cdrain = betap * vds * (vgdt + vgdt + vds);
  542. /*<       gm=twob*vds >*/
  543.     gm = twob * vds;
  544. /*<       gds=twob*vgdt-xlamb*beta*vds*(vgdt+vgdt+vds) >*/
  545.     gds = twob * vgdt - xlamb * beta * vds * (vgdt + vgdt + vds);
  546.  
  547. /*  compute equivalent drain current source */
  548.  
  549. /*<   490 cd=cdrain-cgd >*/
  550. L490:
  551.     cd = cdrain - cgd;
  552. /*<       if (mode.ne.1) go to 500 >*/
  553.     if (status_1.mode != 1) {
  554.     goto L500;
  555.     }
  556. /*<       if ((modedc.eq.2).and.(nosolv.ne.0)) go to 500 >*/
  557.     if (status_1.modedc == 2 && status_1.nosolv != 0) {
  558.     goto L500;
  559.     }
  560. /*<       if (initf.eq.4) go to 500 >*/
  561.     if (status_1.initf == 4) {
  562.     goto L500;
  563.     }
  564. /*<       go to 700 >*/
  565.     goto L700;
  566.  
  567. /*  charge storage elements */
  568.  
  569. /*<   500 czgs=value(locm+6)*area >*/
  570. L500:
  571.     czgs = blank_1.value[locm + 5] * area;
  572. /*<       czgd=value(locm+7)*area >*/
  573.     czgd = blank_1.value[locm + 6] * area;
  574. /*<       phib=value(locm+8) >*/
  575.     phib = blank_1.value[locm + 7];
  576. /*<       twop=phib+phib >*/
  577.     twop = phib + phib;
  578. /*<       fcpb=value(locm+12) >*/
  579.     fcpb = blank_1.value[locm + 11];
  580. /*<       fcpb2=fcpb*fcpb >*/
  581.     fcpb2 = fcpb * fcpb;
  582. /*<       f1=value(locm+13) >*/
  583.     f1 = blank_1.value[locm + 12];
  584. /*<       f2=value(locm+14) >*/
  585.     f2 = blank_1.value[locm + 13];
  586. /*<       f3=value(locm+15) >*/
  587.     f3 = blank_1.value[locm + 14];
  588. /*<       czgsf2=czgs/f2 >*/
  589.     czgsf2 = czgs / f2;
  590. /*<       czgdf2=czgd/f2 >*/
  591.     czgdf2 = czgd / f2;
  592. /*<       if (vgs.ge.fcpb) go to 510 >*/
  593.     if (vgs >= fcpb) {
  594.     goto L510;
  595.     }
  596. /*<       sarg=dsqrt(1.0d0-vgs/phib) >*/
  597.     sarg = sqrt(1. - vgs / phib);
  598. /*<       qgs(lx0+loct)=twop*czgs*(1.0d0-sarg) >*/
  599.     qgs[tabinf_1.lx0 + loct - 1] = twop * czgs * (1. - sarg);
  600. /*<       capgs=czgs/sarg >*/
  601.     capgs = czgs / sarg;
  602. /*<       go to 520 >*/
  603.     goto L520;
  604. /*<   510 qgs(lx0+loct)=czgs*f1+czgsf2*(f3*(vgs-fcpb) >*/
  605. /*<      1   +(vgs*vgs-fcpb2)/(twop+twop)) >*/
  606. L510:
  607.     qgs[tabinf_1.lx0 + loct - 1] = czgs * f1 + czgsf2 * (f3 * (vgs - fcpb) + (
  608.         vgs * vgs - fcpb2) / (twop + twop));
  609. /*<       capgs=czgsf2*(f3+vgs/twop) >*/
  610.     capgs = czgsf2 * (f3 + vgs / twop);
  611. /*<   520 if (vgd.ge.fcpb) go to 530 >*/
  612. L520:
  613.     if (vgd >= fcpb) {
  614.     goto L530;
  615.     }
  616. /*<       sarg=dsqrt(1.0d0-vgd/phib) >*/
  617.     sarg = sqrt(1. - vgd / phib);
  618. /*<       qgd(lx0+loct)=twop*czgd*(1.0d0-sarg) >*/
  619.     qgd[tabinf_1.lx0 + loct - 1] = twop * czgd * (1. - sarg);
  620. /*<       capgd=czgd/sarg >*/
  621.     capgd = czgd / sarg;
  622. /*<       go to 560 >*/
  623.     goto L560;
  624. /*<   530 qgd(lx0+loct)=czgd*f1+czgdf2*(f3*(vgd-fcpb) >*/
  625. /*<      1   +(vgd*vgd-fcpb2)/(twop+twop)) >*/
  626. L530:
  627.     qgd[tabinf_1.lx0 + loct - 1] = czgd * f1 + czgdf2 * (f3 * (vgd - fcpb) + (
  628.         vgd * vgd - fcpb2) / (twop + twop));
  629. /*<       capgd=czgdf2*(f3+vgd/twop) >*/
  630.     capgd = czgdf2 * (f3 + vgd / twop);
  631.  
  632. /*  store small-signal parameters */
  633.  
  634. /*<   560 if ((mode.eq.1).and.(modedc.eq.2).and.(nosolv.ne.0)) go to 700 >*/
  635. L560:
  636.     if (status_1.mode == 1 && status_1.modedc == 2 && status_1.nosolv != 0) {
  637.     goto L700;
  638.     }
  639. /*<       if (initf.ne.4) go to 600 >*/
  640.     if (status_1.initf != 4) {
  641.     goto L600;
  642.     }
  643. /*<       value(lx0+loct+9)=capgs >*/
  644.     blank_1.value[tabinf_1.lx0 + loct + 8] = capgs;
  645. /*<       value(lx0+loct+11)=capgd >*/
  646.     blank_1.value[tabinf_1.lx0 + loct + 10] = capgd;
  647. /*<       go to 1000 >*/
  648.     goto L1000;
  649.  
  650. /*  transient analysis */
  651.  
  652. /*<   600 if (initf.ne.5) go to 610 >*/
  653. L600:
  654.     if (status_1.initf != 5) {
  655.     goto L610;
  656.     }
  657. /*<       qgs(lx1+loct)=qgs(lx0+loct) >*/
  658.     qgs[tabinf_1.lx1 + loct - 1] = qgs[tabinf_1.lx0 + loct - 1];
  659. /*<       qgd(lx1+loct)=qgd(lx0+loct) >*/
  660.     qgd[tabinf_1.lx1 + loct - 1] = qgd[tabinf_1.lx0 + loct - 1];
  661. /*<   610 call intgr8(geq,ceq,capgs,loct+9) >*/
  662. L610:
  663.     i_1 = loct + 9;
  664.     intgr8_(&geq, &ceq, &capgs, &i_1);
  665. /*<       ggs=ggs+geq >*/
  666.     ggs += geq;
  667. /*<       cg=cg+cqgs(lx0+loct) >*/
  668.     cg += cqgs[tabinf_1.lx0 + loct - 1];
  669. /*<       call intgr8(geq,ceq,capgd,loct+11) >*/
  670.     i_1 = loct + 11;
  671.     intgr8_(&geq, &ceq, &capgd, &i_1);
  672. /*<       ggd=ggd+geq >*/
  673.     ggd += geq;
  674. /*<       cg=cg+cqgd(lx0+loct) >*/
  675.     cg += cqgd[tabinf_1.lx0 + loct - 1];
  676. /*<       cd=cd-cqgd(lx0+loct) >*/
  677.     cd -= cqgd[tabinf_1.lx0 + loct - 1];
  678. /*<       cgd=cgd+cqgd(lx0+loct) >*/
  679.     cgd += cqgd[tabinf_1.lx0 + loct - 1];
  680. /*<       if (initf.ne.5) go to 700 >*/
  681.     if (status_1.initf != 5) {
  682.     goto L700;
  683.     }
  684. /*<       cqgs(lx1+loct)=cqgs(lx0+loct) >*/
  685.     cqgs[tabinf_1.lx1 + loct - 1] = cqgs[tabinf_1.lx0 + loct - 1];
  686. /*<       cqgd(lx1+loct)=cqgd(lx0+loct) >*/
  687.     cqgd[tabinf_1.lx1 + loct - 1] = cqgd[tabinf_1.lx0 + loct - 1];
  688.  
  689. /*  check convergence */
  690.  
  691. /*<   700 if (initf.ne.3) go to 710 >*/
  692. L700:
  693.     if (status_1.initf != 3) {
  694.     goto L710;
  695.     }
  696. /*<       if (ioff.eq.0) go to 710 >*/
  697.     if (ioff == 0) {
  698.     goto L710;
  699.     }
  700. /*<       go to 750 >*/
  701.     goto L750;
  702. /*<   710 if (icheck.eq.1) go to 720 >*/
  703. L710:
  704.     if (icheck == 1) {
  705.     goto L720;
  706.     }
  707. /*<       tol=reltol*dmax1(dabs(cghat),dabs(cg))+abstol >*/
  708. /* Computing MAX */
  709.     d_1 = abs(cghat), d_2 = abs(cg);
  710.     tol = knstnt_1.reltol * max(d_2,d_1) + knstnt_1.abstol;
  711. /*<       if (dabs(cghat-cg).ge.tol) go to 720 >*/
  712.     if ((d_1 = cghat - cg, abs(d_1)) >= tol) {
  713.     goto L720;
  714.     }
  715. /*<       tol=reltol*dmax1(dabs(cdhat),dabs(cd))+abstol >*/
  716. /* Computing MAX */
  717.     d_1 = abs(cdhat), d_2 = abs(cd);
  718.     tol = knstnt_1.reltol * max(d_2,d_1) + knstnt_1.abstol;
  719. /*<       if (dabs(cdhat-cd).le.tol) go to 750 >*/
  720.     if ((d_1 = cdhat - cd, abs(d_1)) <= tol) {
  721.     goto L750;
  722.     }
  723. /*<   720 noncon=noncon+1 >*/
  724. L720:
  725.     ++status_1.noncon;
  726. /*<   750 vgso(lx0+loct)=vgs >*/
  727. L750:
  728.     vgso[tabinf_1.lx0 + loct - 1] = vgs;
  729. /*<       vgdo(lx0+loct)=vgd >*/
  730.     vgdo[tabinf_1.lx0 + loct - 1] = vgd;
  731. /*<       cgo(lx0+loct)=cg >*/
  732.     cgo[tabinf_1.lx0 + loct - 1] = cg;
  733. /*<       cdo(lx0+loct)=cd >*/
  734.     cdo[tabinf_1.lx0 + loct - 1] = cd;
  735. /*<       cgdo(lx0+loct)=cgd >*/
  736.     cgdo[tabinf_1.lx0 + loct - 1] = cgd;
  737. /*<       gmo(lx0+loct)=gm >*/
  738.     gmo[tabinf_1.lx0 + loct - 1] = gm;
  739. /*<       gdso(lx0+loct)=gds >*/
  740.     gdso[tabinf_1.lx0 + loct - 1] = gds;
  741. /*<       ggso(lx0+loct)=ggs >*/
  742.     ggso[tabinf_1.lx0 + loct - 1] = ggs;
  743. /*<       ggdo(lx0+loct)=ggd >*/
  744.     ggdo[tabinf_1.lx0 + loct - 1] = ggd;
  745.  
  746. /*  load current vector */
  747.  
  748. /*<   900 ceqgd=type*(cgd-ggd*vgd) >*/
  749. L900:
  750.     ceqgd = type * (cgd - ggd * vgd);
  751. /*<       ceqgs=type*((cg-cgd)-ggs*vgs) >*/
  752.     ceqgs = type * (cg - cgd - ggs * vgs);
  753. /*<       cdreq=type*((cd+cgd)-gds*vds-gm*vgs) >*/
  754.     cdreq = type * (cd + cgd - gds * vds - gm * vgs);
  755. /*<       value(lvn+node2)=value(lvn+node2)-ceqgs-ceqgd >*/
  756.     blank_1.value[tabinf_1.lvn + node2 - 1] = blank_1.value[tabinf_1.lvn + 
  757.         node2 - 1] - ceqgs - ceqgd;
  758. /*<       value(lvn+node4)=value(lvn+node4)-cdreq+ceqgd >*/
  759.     blank_1.value[tabinf_1.lvn + node4 - 1] = blank_1.value[tabinf_1.lvn + 
  760.         node4 - 1] - cdreq + ceqgd;
  761. /*<       value(lvn+node5)=value(lvn+node5)+cdreq+ceqgs >*/
  762.     blank_1.value[tabinf_1.lvn + node5 - 1] = blank_1.value[tabinf_1.lvn + 
  763.         node5 - 1] + cdreq + ceqgs;
  764.  
  765. /*  load y matrix */
  766.  
  767. /*<       locy=lvn+nodplc(loc+20) >*/
  768.     locy = tabinf_1.lvn + nodplc[loc + 19];
  769. /*<       value(locy)=value(locy)+gdpr >*/
  770.     blank_1.value[locy - 1] += gdpr;
  771. /*<       locy=lvn+nodplc(loc+21) >*/
  772.     locy = tabinf_1.lvn + nodplc[loc + 20];
  773. /*<       value(locy)=value(locy)+ggd+ggs >*/
  774.     blank_1.value[locy - 1] = blank_1.value[locy - 1] + ggd + ggs;
  775. /*<       locy=lvn+nodplc(loc+22) >*/
  776.     locy = tabinf_1.lvn + nodplc[loc + 21];
  777. /*<       value(locy)=value(locy)+gspr >*/
  778.     blank_1.value[locy - 1] += gspr;
  779. /*<       locy=lvn+nodplc(loc+23) >*/
  780.     locy = tabinf_1.lvn + nodplc[loc + 22];
  781. /*<       value(locy)=value(locy)+gdpr+gds+ggd >*/
  782.     blank_1.value[locy - 1] = blank_1.value[locy - 1] + gdpr + gds + ggd;
  783. /*<       locy=lvn+nodplc(loc+24) >*/
  784.     locy = tabinf_1.lvn + nodplc[loc + 23];
  785. /*<       value(locy)=value(locy)+gspr+gds+gm+ggs >*/
  786.     blank_1.value[locy - 1] = blank_1.value[locy - 1] + gspr + gds + gm + ggs;
  787.  
  788. /*<       locy=lvn+nodplc(loc+9) >*/
  789.     locy = tabinf_1.lvn + nodplc[loc + 8];
  790. /*<       value(locy)=value(locy)-gdpr >*/
  791.     blank_1.value[locy - 1] -= gdpr;
  792. /*<       locy=lvn+nodplc(loc+10) >*/
  793.     locy = tabinf_1.lvn + nodplc[loc + 9];
  794. /*<       value(locy)=value(locy)-ggd >*/
  795.     blank_1.value[locy - 1] -= ggd;
  796. /*<       locy=lvn+nodplc(loc+11) >*/
  797.     locy = tabinf_1.lvn + nodplc[loc + 10];
  798. /*<       value(locy)=value(locy)-ggs >*/
  799.     blank_1.value[locy - 1] -= ggs;
  800. /*<       locy=lvn+nodplc(loc+12) >*/
  801.     locy = tabinf_1.lvn + nodplc[loc + 11];
  802. /*<       value(locy)=value(locy)-gspr >*/
  803.     blank_1.value[locy - 1] -= gspr;
  804. /*<       locy=lvn+nodplc(loc+13) >*/
  805.     locy = tabinf_1.lvn + nodplc[loc + 12];
  806. /*<       value(locy)=value(locy)-gdpr >*/
  807.     blank_1.value[locy - 1] -= gdpr;
  808. /*<       locy=lvn+nodplc(loc+14) >*/
  809.     locy = tabinf_1.lvn + nodplc[loc + 13];
  810. /*<       value(locy)=value(locy)+gm-ggd >*/
  811.     blank_1.value[locy - 1] = blank_1.value[locy - 1] + gm - ggd;
  812. /*<       locy=lvn+nodplc(loc+15) >*/
  813.     locy = tabinf_1.lvn + nodplc[loc + 14];
  814. /*<       value(locy)=value(locy)-gds-gm >*/
  815.     blank_1.value[locy - 1] = blank_1.value[locy - 1] - gds - gm;
  816. /*<       locy=lvn+nodplc(loc+16) >*/
  817.     locy = tabinf_1.lvn + nodplc[loc + 15];
  818. /*<       value(locy)=value(locy)-ggs-gm >*/
  819.     blank_1.value[locy - 1] = blank_1.value[locy - 1] - ggs - gm;
  820. /*<       locy=lvn+nodplc(loc+17) >*/
  821.     locy = tabinf_1.lvn + nodplc[loc + 16];
  822. /*<       value(locy)=value(locy)-gspr >*/
  823.     blank_1.value[locy - 1] -= gspr;
  824. /*<       locy=lvn+nodplc(loc+18) >*/
  825.     locy = tabinf_1.lvn + nodplc[loc + 17];
  826. /*<       value(locy)=value(locy)-gds >*/
  827.     blank_1.value[locy - 1] -= gds;
  828. /*<  1000 loc=nodplc(loc) >*/
  829. L1000:
  830.     loc = nodplc[loc - 1];
  831. /*<       go to 10 >*/
  832.     goto L10;
  833. /*<       end >*/
  834. } /* jfet_ */
  835.  
  836. #undef qgs
  837. #undef gmo
  838. #undef qgd
  839. #undef cgo
  840. #undef cdo
  841. #undef cvalue
  842. #undef nodplc
  843. #undef vgso
  844. #undef cqgs
  845. #undef ggso
  846. #undef vgdo
  847. #undef gdso
  848. #undef ggdo
  849. #undef cqgd
  850. #undef cgdo
  851.  
  852.  
  853.